library(readr)
census_starter <- read_csv("godaddy-microbusiness-density-forecasting/census_starter.csv")
train <- read_csv("godaddy-microbusiness-density-forecasting/train.csv")
test <- read_csv("godaddy-microbusiness-density-forecasting/test.csv")
IDS <- unique(train$cfips)
x_train <- array(0:(39-1), dim=c(39,1)) #Use the first 38 months to train
x_test <- array(38:47, dim=c(10,1)) #Use following 10 months to test
preds <- matrix(0, nrow = length(IDS), ncol=8) #Create matrix of 0's for predictions
last_preds <- matrix(0, nrow = length(IDS), ncol = 8) #Create matrix of 0's for last predictions
lin_trend = 0
ct = 0
for (i,c) in seq_along(IDS) {
df <- train[train$cfips==c,]
last <- df$microbusiness_density[length(df$microbusiness_density)]
active <-
}
Nested Data
Nested Data Frames by County
library(modelr)
library(tidyverse)
library(dplyr)
library(gapminder)
#Nest
by_county <- train %>%
group_by(cfips, state) %>%
nest()
#Model-fitting function
county_model <- function(df) {
lm(microbusiness_density ~ first_day_of_month, data = df)
}
#Apply to each element
models <- map(by_county$data, county_model)
#Adding models to dataframe
by_county <- by_county %>%
mutate(model = map(data, county_model))
by_county %>%
filter(state == "Texas")
#Adding residuals of each model
by_county <- by_county %>%
mutate(
resids = map2(data, model, add_residuals)
)
#Unnesting
resids <- unnest(by_county, resids)
#Plotting the residuals
resids %>%
ggplot(aes(first_day_of_month, resid)) +
geom_line(aes(group = cfips), alpha = 1/3) +
geom_smooth(se = FALSE)

#Facetting by state
resids %>%
ggplot(aes(first_day_of_month, resid, group = cfips)) +
geom_line(alpha = 1/3) +
facet_wrap(~state)

#Extracting model quality
glance <- by_county %>%
mutate(glance = map(model, broom::glance)) %>%
unnest(glance)
#Arrange by R square
glance %>%
arrange(r.squared)
#Plot worst r squared
glance %>%
ggplot(aes(state, r.squared)) +
geom_jitter(width = 0.5) +
theme(axis.text.x = element_text(angle = 90))

#Fable #Load packages
library(fable)
library(tsibble)
library(tsibbledata)
library(lubridate)
library(dplyr)
#Keeping tibble format
texas_001 <- by_county %>%
filter(
state %in% c("Texas"),
cfips == "48001"
)
by_county %>%
filter(
state %in% c("Texas"),
cfips == "48001"
) %>%
model(
ets = ETS(box_cox(microbusiness_density, 0.3)),
arima = ARIMA(log(microbusiness_density)),
snaive = SNAIVE(microbusiness_density)
) %>%
forecast(h ="2 months") %>%
autoplot(filter(by_county))
t
LS0tCnRpdGxlOiAiZ29kYWRkeSBuZXN0ZWQgZGF0YSIKb3V0cHV0OgogIGh0bWxfZG9jdW1lbnQ6CiAgICBkZl9wcmludDogcGFnZWQKLS0tCgoKCmBgYHtyfQpsaWJyYXJ5KHJlYWRyKQpjZW5zdXNfc3RhcnRlciA8LSByZWFkX2NzdigiZ29kYWRkeS1taWNyb2J1c2luZXNzLWRlbnNpdHktZm9yZWNhc3RpbmcvY2Vuc3VzX3N0YXJ0ZXIuY3N2IikKdHJhaW4gPC0gcmVhZF9jc3YoImdvZGFkZHktbWljcm9idXNpbmVzcy1kZW5zaXR5LWZvcmVjYXN0aW5nL3RyYWluLmNzdiIpCnRlc3QgPC0gcmVhZF9jc3YoImdvZGFkZHktbWljcm9idXNpbmVzcy1kZW5zaXR5LWZvcmVjYXN0aW5nL3Rlc3QuY3N2IikKYGBgCgpgYGB7cn0KSURTIDwtIHVuaXF1ZSh0cmFpbiRjZmlwcykKCnhfdHJhaW4gPC0gYXJyYXkoMDooMzktMSksIGRpbT1jKDM5LDEpKSAjVXNlIHRoZSBmaXJzdCAzOCBtb250aHMgdG8gdHJhaW4KeF90ZXN0IDwtIGFycmF5KDM4OjQ3LCBkaW09YygxMCwxKSkgI1VzZSBmb2xsb3dpbmcgMTAgbW9udGhzIHRvIHRlc3QKCnByZWRzIDwtIG1hdHJpeCgwLCBucm93ID0gbGVuZ3RoKElEUyksIG5jb2w9OCkgI0NyZWF0ZSBtYXRyaXggb2YgMCdzIGZvciBwcmVkaWN0aW9ucwpsYXN0X3ByZWRzIDwtIG1hdHJpeCgwLCBucm93ID0gbGVuZ3RoKElEUyksIG5jb2wgPSA4KSAjQ3JlYXRlIG1hdHJpeCBvZiAwJ3MgZm9yIGxhc3QgcHJlZGljdGlvbnMKbGluX3RyZW5kID0gMAoKY3QgPSAwCmBgYAoKYGBge3J9CmZvciAoaSxjKSBpbiBzZXFfYWxvbmcoSURTKSB7CiAgZGYgPC0gdHJhaW5bdHJhaW4kY2ZpcHM9PWMsXQogIGxhc3QgPC0gZGYkbWljcm9idXNpbmVzc19kZW5zaXR5W2xlbmd0aChkZiRtaWNyb2J1c2luZXNzX2RlbnNpdHkpXQogIGFjdGl2ZSA8LSAKfQpgYGAKCgojIyMgTmVzdGVkIERhdGEKCiMgTmVzdGVkIERhdGEgRnJhbWVzIGJ5IENvdW50eQpgYGB7cn0KbGlicmFyeShtb2RlbHIpCmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KGRwbHlyKQpsaWJyYXJ5KGdhcG1pbmRlcikKYGBgCiNOZXN0CmBgYHtyfQpieV9jb3VudHkgPC0gdHJhaW4gJT4lCiAgZ3JvdXBfYnkoY2ZpcHMsIHN0YXRlKSAlPiUKICBuZXN0KCkKYGBgCiNNb2RlbC1maXR0aW5nIGZ1bmN0aW9uCmBgYHtyfQpjb3VudHlfbW9kZWwgPC0gZnVuY3Rpb24oZGYpIHsKICBsbShtaWNyb2J1c2luZXNzX2RlbnNpdHkgfiBmaXJzdF9kYXlfb2ZfbW9udGgsIGRhdGEgPSBkZikKfQpgYGAKI0FwcGx5IHRvIGVhY2ggZWxlbWVudApgYGB7cn0KbW9kZWxzIDwtIG1hcChieV9jb3VudHkkZGF0YSwgY291bnR5X21vZGVsKQpgYGAKI0FkZGluZyBtb2RlbHMgdG8gZGF0YWZyYW1lCmBgYHtyfQpieV9jb3VudHkgPC0gYnlfY291bnR5ICU+JQogIG11dGF0ZShtb2RlbCA9IG1hcChkYXRhLCBjb3VudHlfbW9kZWwpKQpgYGAKCmBgYHtyfQpieV9jb3VudHkgJT4lIAogIGZpbHRlcihzdGF0ZSA9PSAiVGV4YXMiKQpgYGAKI0FkZGluZyByZXNpZHVhbHMgb2YgZWFjaCBtb2RlbApgYGB7cn0KYnlfY291bnR5IDwtIGJ5X2NvdW50eSAlPiUKICBtdXRhdGUoCiAgICByZXNpZHMgPSBtYXAyKGRhdGEsIG1vZGVsLCBhZGRfcmVzaWR1YWxzKQogICkKYGBgCiNVbm5lc3RpbmcKYGBge3J9CnJlc2lkcyA8LSB1bm5lc3QoYnlfY291bnR5LCByZXNpZHMpCmBgYAojUGxvdHRpbmcgdGhlIHJlc2lkdWFscwpgYGB7cn0KcmVzaWRzICU+JQogIGdncGxvdChhZXMoZmlyc3RfZGF5X29mX21vbnRoLCByZXNpZCkpICsKICBnZW9tX2xpbmUoYWVzKGdyb3VwID0gY2ZpcHMpLCBhbHBoYSA9IDEvMykgKwogIGdlb21fc21vb3RoKHNlID0gRkFMU0UpCgpgYGAKI0ZhY2V0dGluZyBieSBzdGF0ZQpgYGB7cn0KcmVzaWRzICU+JSAKICBnZ3Bsb3QoYWVzKGZpcnN0X2RheV9vZl9tb250aCwgcmVzaWQsIGdyb3VwID0gY2ZpcHMpKSArCiAgZ2VvbV9saW5lKGFscGhhID0gMS8zKSArCiAgZmFjZXRfd3JhcCh+c3RhdGUpCmBgYAojRXh0cmFjdGluZyBtb2RlbCBxdWFsaXR5CmBgYHtyfQpnbGFuY2UgPC0gYnlfY291bnR5ICU+JSAKICBtdXRhdGUoZ2xhbmNlID0gbWFwKG1vZGVsLCBicm9vbTo6Z2xhbmNlKSkgJT4lCiAgdW5uZXN0KGdsYW5jZSkKYGBgCiNBcnJhbmdlIGJ5IFIgc3F1YXJlCmBgYHtyfQpnbGFuY2UgJT4lIAogIGFycmFuZ2Uoci5zcXVhcmVkKQpgYGAKI1Bsb3Qgd29yc3QgciBzcXVhcmVkCmBgYHtyfQpnbGFuY2UgJT4lIAogIGdncGxvdChhZXMoc3RhdGUsIHIuc3F1YXJlZCkpICsKICBnZW9tX2ppdHRlcih3aWR0aCA9IDAuNSkgKwogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gOTApKQpgYGAKCiNGYWJsZSAKI0xvYWQgcGFja2FnZXMKYGBge3J9CmxpYnJhcnkoZmFibGUpCmxpYnJhcnkodHNpYmJsZSkKbGlicmFyeSh0c2liYmxlZGF0YSkKbGlicmFyeShsdWJyaWRhdGUpCmxpYnJhcnkoZHBseXIpCmBgYAojS2VlcGluZyB0aWJibGUgZm9ybWF0CmBgYHtyfQp0ZXhhc18wMDEgPC0gYnlfY291bnR5ICU+JQogIGZpbHRlcigKICAgIHN0YXRlICVpbiUgYygiVGV4YXMiKSwKICAgIGNmaXBzID09ICI0ODAwMSIKICApCmBgYAoKYGBge3J9CmJ5X2NvdW50eSAlPiUKICBmaWx0ZXIoCiAgICBzdGF0ZSAlaW4lIGMoIlRleGFzIiksCiAgICBjZmlwcyA9PSAiNDgwMDEiCiAgKSAlPiUKICBtb2RlbCgKICAgIGV0cyA9IEVUUyhib3hfY294KG1pY3JvYnVzaW5lc3NfZGVuc2l0eSwgMC4zKSksCiAgICBhcmltYSA9IEFSSU1BKGxvZyhtaWNyb2J1c2luZXNzX2RlbnNpdHkpKSwKICAgIHNuYWl2ZSA9IFNOQUlWRShtaWNyb2J1c2luZXNzX2RlbnNpdHkpCiAgKSAlPiUKICBmb3JlY2FzdChoID0iMiBtb250aHMiKSAlPiUKICBhdXRvcGxvdChmaWx0ZXIoYnlfY291bnR5KSkKYGBgCgp0